home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form Pins
- BorderStyle = 3 'Fixed Dialog
- Caption = "Pins sample"
- ClientHeight = 4785
- ClientLeft = 1245
- ClientTop = 1065
- ClientWidth = 7035
- Height = 5475
- Left = 1185
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4785
- ScaleWidth = 7035
- ShowInTaskbar = 0 'False
- Top = 435
- Width = 7155
- Begin VB.TextBox Text1
- Height = 765
- Left = 90
- Locked = -1 'True
- MultiLine = -1 'True
- TabIndex = 1
- Text = "PINS.frx":0000
- Top = 120
- Width = 5865
- End
- Begin VB.CommandButton Command1
- Caption = "&Delete"
- Height = 465
- Left = 6060
- TabIndex = 0
- Top = 120
- Width = 885
- End
- Begin AddFlowLib.AddFlow AddFlow1
- Height = 3765
- Left = 120
- TabIndex = 2
- Top = 960
- Width = 6855
- _Version = 65536
- _ExtentX = 12091
- _ExtentY = 6641
- _StockProps = 101
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- name = "Arial"
- charset = 0
- weight = 400
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- BorderStyle = 1
- ScrollBars = 3
- Shape = 1
- LinkStyle = 0
- Alignment = 7
- AutoSize = 0
- ArrowDst = 1
- ArrowOrg = 1
- DrawStyle = 0
- DrawWidth = 1,4013e-45
- ReadOnly = 0 'False
- MultiSel = -1 'True
- CanDrawNode = -1 'True
- CanDrawLink = -1 'True
- CanMoveNode = -1 'True
- CanSizeNode = -1 'True
- CanStretchLink = -1 'True
- CanMultiLink = -1 'True
- Transparent = 0 'False
- ShowGrid = 0 'False
- Hidden = 0 'False
- Rigid = 0 'False
- DisplayHandles = -1 'True
- AutoScroll = -1 'True
- xGrid = 7,00649e-45
- yGrid = 7,00649e-45
- xZoom = 100
- yZoom = 100
- FillColor = 12648384
- DrawColor = 0
- ForeColor = 0
- BackPicture = "PINS.frx":00F4
- End
- Begin VB.Menu FileMenu
- Caption = "&File"
- Begin VB.Menu ExitMenu
- Caption = "&Exit"
- End
- End
- Begin VB.Menu HelpMenu
- Caption = "&?"
- Begin VB.Menu AboutMenu
- Caption = "&About..."
- End
- End
- Attribute VB_Name = "Pins"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Private Sub AboutMenu_Click()
- MsgBox "AddFlow: sample that shows how to use Rigid property" + Chr(13) + "Copyright
- 1997 Lassalle Technologies"
- End Sub
- Private Sub AddFlow1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim lnkx As afLink
- Dim nodeorg As afNode, nodedst As afNode, Org As afNode, Dst As afNode
- Dim Xorg As Single, Yorg As Single, Xdst As Single, Ydst As Single
- If AddFlow1.LastUserAction() = 2 Then ' Link creation
- Set lnkx = AddFlow1.SelectedLink
- If Not (lnkx Is Nothing) Then
- ' Get first and last point of the link
- Xorg = lnkx.PointOrg.X
- Yorg = lnkx.PointOrg.Y
- Xdst = lnkx.PointDst.X
- Ydst = lnkx.PointDst.Y
- ' Get origin and destination nodes of our just created link
- Set Dst = lnkx.Dst
- Set Org = lnkx.Org
- ' Now destroy the link ...
- Org.OutLinks.Remove lnkx
- ' Create 2 little hidden pins:
- ' - the first is owned by the origin node
- ' - the second is owned by the destination node
- Set nodeorg = AddFlow1.Nodes.Add(Xorg - 15, Yorg - 15, 30, 30)
-
- ' Create a rigid link from Org to nodeorg
- Set lnkx = Org.OutLinks.Add(nodeorg)
- lnkx.Rigid = True
- lnkx.Hidden = True
- lnkx.Selectable = False
- Set nodedst = AddFlow1.Nodes.Add(Xdst - 15, Ydst - 15, 30, 30)
-
- ' Create a rigid link from Dst to nodedst
- Set lnkx = Dst.OutLinks.Add(nodedst)
- lnkx.Rigid = True
- lnkx.Hidden = True
- lnkx.Selectable = False
-
- ' ... and recreate a new one with the two pins
- ' as origin and destination.
- Set lnkx = nodeorg.OutLinks.Add(nodedst)
-
- ' Make the two little black node unselectable and hidden
- nodeorg.Hidden = True
- nodeorg.Selectable = False
- nodedst.Hidden = True
- nodedst.Selectable = False
- End If
- End If
- End Sub
- Private Sub Command1_Click()
- Dim lnkx As afLink, lnkx2 As afLink
- ' Instead of removing each item with Remove method of collection, we
- ' mark them and use at the ned the DeleteMarked method that deletes
- ' all marked items.
- With AddFlow1
- If .SelectedNode Is Nothing And .SelectedLink Is Nothing Then
- ' Do nothing
- ElseIf .SelectedNode Is Nothing Then
- ' If current item is a link, delete its origin and destination nodes.
- .SelectedLink.Org.Marked = True
- .SelectedLink.Dst.Marked = True
- Else
- ' If current item is a node, delete all its pins (= nodes
- ' rigidly linked). We have also to destroy the other pin at the
- ' other end of the link.
- For Each lnkx In .SelectedNode.OutLinks
- If lnkx.Rigid = True Then
- ' Mark the pin owned by SelectedNode
- lnkx.Dst.Marked = True
- ' Mark all linked nodes for deletion.
- ' Note: this will remove SelectedNode
- For Each lnkx2 In lnkx.Dst.OutLinks
- lnkx2.Dst.Marked = True
- Next
- For Each lnkx2 In lnkx.Dst.InLinks
- lnkx2.Org.Marked = True
- Next
- End If
- Next
- .SelectedNode.Marked = True
- End If
- .DeleteMarked
- End With
- End Sub
- Private Sub ExitMenu_Click()
- End
- End Sub
- Private Sub Form_Load()
- AddFlow1.Shape = afRectangle
- End Sub
-